Here is yet another example of how I make use of clever routines devised by others more knowledgeable than me. The program uses a recursive routine devise by Mark Parkinson some time ago to find all the Media files in any selected drive. The drive is first chosen using Drives.Bas supplied with LB, then the type of file to be found is selected by .EXT using Radio Buttons. Mark's search routine is used to find all the files, which can be displayed, either by a button menu for activating, or alternatively in the form of a list, showing their location, using Notepad. This latter of course allows us to retain the list by saving it as a file, or by the usual COPY and PASTE methods, not forgetting to click on the display beforehand, as is customary. The normal method of creating 90 Windows buttons could have been used, but might prove rather cumbersome, especially if you want to create a similar color scheme.
Once a file is activated, it is played using the nice simple routine used in Hockey.bas by David Drake, also supplied with LB. Fortunately I not only discovered the routine can easily be changed to play MP3 files, but by using the same parameters it also plays the MPEG, AVI and WMV video files. However this fairly simple routine needs to be stopped at some stage, hence the need for the 'NEXT' confirmation box. I must point out that there are far more comprehensive routines detailed in the excellent e-book sold by Alyce Watson from her web site. These will not only pause and resume playing a file, and stop the file when completed automatically, but can easily be modified to display the video files full screen if preferred.
Gordon Sweet gordon@gsweet.fsnet.co.uk
' With acknowledgents to Mark Parkinson for the Recursive Files routine
' and acknowledgements to David Drake for the Multiplayer in Hockey.bas
'WORKS FROM ROOT DIR
nomainwin
dim file$(10000,2) : dim info$(10, 10) : dim Q(2)
[pick]
' Backgound Window to fill larger displays
open "Background" for graphics_fs_nsb as #bg
#bg "trapclose [quit]; down; fill darkgreen; flush"
ux = 1 : uy = 1 ' determine Display used
if (DisplayWidth > 1000) then ux = 120 : uy = 90
UpperLeftX = ux : UpperLeftY = uy
WindowWidth = 800 : WindowHeight = 600
tl$ = "Listing of Music or Video files."
open tl$ for graphics_nf_nsb as #m
redim file$(10000,2) : redim info$(10, 10) : redim Q(2)
#m "discard; trapclose [quit]; down" : mplay = 0 : abort = 0
#m "when leftButtonDown; when rightButtonDown"
#m "font ariel 30 bold; fill 100 40 10; color white"
#m "backcolor 100 40 10; place 180 50"
#m "\Menu of VIDEO/MUSIC Files"
#m "font ariel 10; color yellow; place 300 90"
#m "\by Gordon Sweet - ver. 1.2 - April 2003"
#m "font arial 14 bold; place 80 140"
#m "\This searches for all the MID, MP3, AVI, MPEG, or WMV files on any Drive"
#m "\then produces either a Menu or a List including all the Directories.\"
WindowHeight=260 : WindowWidth=150 ' DRIVE SELECTION
UpperLeftX = 350+ux : UpperLeftY = 300+uy
dim letters$(25) : index = 0 : DRV$="c:"
while word$(Drives$, index + 1) <> ""
letters$(index) = word$(Drives$, index + 1)
index = index + 1
wend
statictext #choose, "Double-click to pick a drive:", 5, 10, 200, 20
listbox #choose.list, letters$(, [Made], 20, 35, 100, 150
open "Scan drive" for dialog_popup as #choose
print #choose, "trapclose [quitdrv]"
mainH=hWnd(#choose) : gosub [boxhold]
misic$ = "off" : win1 = 1 : winc = 1: #m "flush"
playwave "XXX" : wait
[Made] print #choose.list, "selection? DRV$"
[quitdrv]
close #choose : winc = 0 : win1 = 1
DRV$=upper$(DRV$) : tdr$ = "Current Search Drive "+DRV$
men = 1 : alpha = 0
UpperLeftX = 210+ux : UpperLeftY = 250+uy ' SELECT FILE TYPE BY .EXT
WindowWidth = 420 : WindowHeight = 220
groupbox #cfg, "Select Menu or Listing", 240, 20, 90, 90
radiobutton #cfg.menu, "Menu", [menu], [halt], 260, 45, 50, 20
radiobutton #cfg.lst "Listing", [lst], [halt], 260, 70, 50, 20
groupbox #cfg, "File Type", 130, 20, 90, 130
radiobutton #cfg.mid, "MID", [midl], [halt], 150, 40, 50, 20
radiobutton #cfg.mp3, "MP3", [mp3l], [halt], 150, 60, 50, 20
radiobutton #cfg.mpg, "MPEG", [mpgl], [halt], 150, 80, 50, 20
radiobutton #cfg.avi, "AVI", [avil], [halt], 150, 100, 50, 20
radiobutton #cfg.wmv, "WMV", [wmvl], [halt], 150, 120, 50, 20
groupbox #cfg, "Sort by:", 20, 20, 90, 90
radiobutton #cfg.dir, "Directories", [dirs], [halt], 25, 45, 80, 20
radiobutton #cfg.alpha, "Alphabetical", [alph], [halt], 25, 70, 80, 20
button #cfg, " &OK ", [cfgOk], UL, 350, 70
open tdr$ for dialog as #cfg
print #cfg, "trapclose [quit]"
print #cfg.menu, "set"
print #cfg.dir, "set"
print #cfg.mid, "set" : ext$ = "*.mid"
mainH=hWnd(#cfg) : gosub [boxhold]
[halt]
win2 = 1 : wait
[cfgOk]
close #cfg : win2 = 0 : goto [search]
[midl] ext$ = "*.mid" : goto [halt]
[mp3l] ext$ = "*.mp3" : goto [halt]
[avil] ext$ = "*.avi" : goto [halt]
[mpgl] ext$ = "*.mpeg" : goto [halt]
[wmvl] ext$ = "*.wmv" : goto [halt]
[menu] men = 1 : goto [halt]
[lst] men = 0 : goto [halt]
[dir] alpha = 0 : goto [halt]
[alph] alpha = 1 : goto [halt]
[search]
if (ext$="*.mpeg") then sf$=right$(ext$,4) else sf$=right$(ext$,3)
#m "font ariel 14 bold; color white; place 200 250"
#m "\PLEASE WAIT FILE LIST BEING CREATED"
#m "\OF ALL OF THE ";upper$(sf$);" FILES IN DRIVE ";DRV$
if (men = 1) then #m "\\LEFT click to select, RIGHT click next page."
' Mark Parkinson Recursive Files search routine
placetohunt$=DRV$ : thingtohuntfor$=ext$
C = Q(1) : call recurse placetohunt$, thingtohuntfor$
for f = 1 to Q(1)
tfile$=file$(f,1)
t$="" : ltr = len(tfile$)
while t$<>"\"
t$ = mid$(tfile$,ltr,1)
ltr = ltr -1
wend
n = len(tfile$)-ltr-1
file$(f,2) = right$(tfile$,n)
if len(file$(f,2))>18 then file$(f,2)=left$(file$(f,2),18)
next f
if (alpha = 1) then sort file$(), 1, Q(1), 2
if (men = 0) then [list]
#m "\ LEFT click to Activate, RIGHT click for Next Page "
[start]
start = 1 : last = 95
[show]
#m "discard; cls; when leftButtonDown [which]; when rightButtonDown [next]"
#m "font fixedsys; fill 100 40 10"
#m "backcolor darkblue; color yellow"
yp = 10 : butn = start
for row = 1 to 19 : xp = 4
for colm = 1 to 5
#m "place ";xp;" ";yp
#m "boxfilled ";xp+140;" ";yp+20
#m "place ";xp+10;" ";yp+14
#m p$ : n = butn - 1 + colm
show$ = "\"+file$(n,2)
if (len(show$) > 16) then show$=left$(show$,16)
#m show$;
xp=xp+160
next colm : xp = 1
yp = yp + 30 : butn = butn + 5 : next row
[hold]
wait
[next]
if (last >= Q(1) ) then
start = 1
last = 95
goto [show]
end if
start = start + 95 : last = last + 95
goto [show]
[which]
x=MouseX : y=MouseY
if ((x < 4) or (x > 780)) then [hold]
if (y < 10) then [hold]
across = 10 : down = 28 : row = -1
for check = 1 to 19
if ((y > across) and (y < down)) then row = check -1
across = across + 30 : down = down + 30
next check
row = row * 5
across = 5 : down = 142 : count = 0
for check = 1 to 5
if ((x > across) and (x < down)) then count = check
across = across + 160 : down = down + 160
next check
if ((check = 0) or (row < 0) or (count = 0)) then [hold]
count = count + row : if count > Q(1) then [hold]
cp = count + start -1
mus$ = file$(cp,1)
#m "flush"
gosub [play]
confirm "Next File?"; next$
gosub [stopMusic]
if (next$ = "yes") then [start] else [quit]
[list]
open "c:\temp.$$$" for output as #temp
for h = 1 to Q(1)
#temp h;" = ";file$(h,1)
next h
close #temp
run "notepad.exe c:\temp.$$$", showmaximized
notice "ok" : kill "c:\temp.$$$"
goto [quit]
[play]
' modified from Hockey.bas supplied with LB
music$ = "on"
mus$ = GetShortPathName$(mus$)
ext$ = upper$(right$(mus$,3))
' covers MP3, MPEG, AVI and WMV
a$="open "+mus$+" type MpegVideo alias fictoplay"
if (ext$ = "MID") then a$="open "+mus$+" type sequencer alias fictoplay"
calldll #winmm,"mciSendStringA",a$ as ptr,_
i1 as ulong,_
i2 as long,_
i3 as long,_
r as long
a$="play fictoplay"
calldll #winmm,"mciSendStringA",_
a$ as ptr,_
i1 as ulong,_
i2 as long,_
i3 as long,_
r as long
return
[stopMusic]
music$ = "off"
a$="close fictoplay"
calldll #winmm,"mciSendStringA",_
a$ as ptr,_
i1 as ulong,_
i2 as long,_
i3 as long,_
r as long
return
[quit]
if music$ = "on" then gosub [stopMusic]
if winc = 1 then close #choose
if win1 = 1 then close #m
if win2 = 1 then close #cfg
if win3 = 1 then close #1
close #bg
confirm "OK to Quit?"; quit$
if quit$ = "no" then [pick]
end
Function noPath$(t$)
while instr(t$, "\")
t$ = mid$(t$, 2)
wend
noPath$ = t$
end function
Function GetShortPathName$(lPath$)
lPath$=lPath$+chr$(0)
sPath$=space$(256)
lenPath=len(sPath$)
open "kernel32" for dll as #k
calldll #k, "GetShortPathNameA",lPath$ as ptr,_
sPath$ as ptr,lenPath as long,r as long
close #k
GetShortPathName$=left$(sPath$,r)
end function
sub recurse pathspec$,mask$
'Put in the backslash separator.
pathspec$=pathspec$+"\"
files pathspec$, mask$, info$(
filecount=val(info$(0, 0))
subdircount=val(info$(0, 1))
for i=1 to filecount
filename$= pathspec$+info$(i, 0)
filesize$= info$(i, 1)
datestamp$=info$(i, 2)
if instr(filename$,"Filemenu")>0 then [miss]
if instr(filename$,"Run.exe")>0 then [miss]
Q(1) = Q(1) + 1
file$(Q(1),1) = upper$(filename$)
[miss] next i
for i=1 to subdircount
list$=list$+pathspec$+info$(f + i, 1)+"*"
next i
while list$<>""
p=instr(list$,"*")
p$=left$(list$,p-1)
call recurse p$,mask$
list$=mid$(list$,p+1)
wend
end sub
[boxhold]
open "user32" for dll as #user ' prevents losing box
toTop=(-1 or 0)
flags=_SWP_NOMOVE or _SWP_NOSIZE
calldll #user,"SetWindowPos",mainH as ushort,toTop as short,_
0 as short,0 as short,0 as short,0 as short,flags as ushort,_
result as void
close #user : return